﻿<%
'//---------------------------------------------------------------------------
'//ASP 模板引擎 Taihom.Template.class v2.8
'//Code By Taihom
'//Taihom 原创
'//版权说明
'//本类允许转载、复制和修改，但转载、复制和修改的同时请保留原始的出处和作者声明，这也是对作者Taihom劳动成果的一种尊重！
'//如果您对本类进行修改，希望您也可以给我发一份您修改过后的类(taihom@163.com)
'//---------------------------------------------------------------------------

'''todo 待修改
Class TemplateManageClass
'//----声明
Private intStartTime
Private strAuthor,strVersion
Private strFileLoadFail
Private strCharset,strSITEROOT,strTemplate_dir,strTemplate_path,strCache_dir,strVirPath
Private strTemplate,strCachePage,strCachePageName
Private intAbsPath,intCachePageTimeout,intCreateCachePage
Private var_list,var_loopblocklist,block_if,block_loop,block_loop_list,block_attr_list
Private rsField
Private ops

'//---常用对象
Private objFSO,objDom,regEx

'//---------------------------定义类的事件-------------------------------//
'//类初始化
Private Sub Class_Initialize()
  intStartTime = Timer()
  
  '//---默认变量
  strCharset = "utf-8"
  strCache_dir = "/cache/"'后面需要带/
  strTemplate_dir = "/templates/"'后面需要带/
  strFileLoadFail = "模板@path加载失败"
  intAbsPath = 1 '输出结果是否使用绝对路径
  intCachePageTimeout = 0 '整个页面的缓存超时
  
  ops = "==|<=|&lt;=|>=|&gt;=|>|&gt;|<|&lt;|!=|<>|&lt;&gt;"'支持的if运算符
  
  '//---常用对象
  Set var_list 			= dic()'加入的名值对象
  Set var_loopblocklist = dic()'循环体内容的值
  Set block_if			= dic()'if块的对象
  Set block_loop		= dic()'loop块的对象
  Set rsField			= dic()'应用到loop中的字段名
  Set block_attr_list 	= dic()'块属性输出
  Set block_loop_list 	= dic()'块输出对象
  
  '//---
  Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
  Set regEx = New RegExp
      regEx.Global = True
      regEx.IgnoreCase = True
End Sub

'//----Class_Terminate()
'//类退出
Private Sub Class_Terminate()
  Set var_list = Nothing
  Set var_loopblocklist = Nothing
  
  Set block_if = Nothing
  Set block_loop = Nothing
  Set rsField = Nothing
  Set block_attr_list = Nothing
  Set block_loop_list = Nothing
    
  Set regEx = Nothing
  Set objFSO = Nothing
End Sub
'//---------------------------用户自己定义的方法，私有的-------------------------------//
'//字典对象
Private Function dic()
  Set dic = Server.CreateObject("Scripting.Dictionary")
End Function

'//三目运算,表达式，返回值1，返回值2
Private Function iif(a,b,c)
  If a Then iif=b Else iif=c End IF
End Function

'//FSO自动生成文件夹路径
Private Function AutoCreateFolder(ByVal strPath)
on error resume next
  Dim i , folder , path : path = Trim(strPath)
  AutoCreateFolder = True
  '//看看是否已经存在目录
  If objFSO.FolderExists(path) Then
     Exit Function
  Else
     path = Replace(path,"/","\")
     path = Split(path,"\")
	 For i = 0 To Ubound(path)
	    folder = folder & path(i) & "\"	
		If Not objFSO.folderExists(folder) Then
		objFSO.CreateFolder(folder)
		End If
	 Next
	 
	 AutoCreateFolder = iif((Err.Number = 0),True,False)
  End If
End Function

'//读取模板文件
Private Function LoadFile(ByVal strFilePath,ByVal strCharset)
  If objFSO.FileExists(strFilePath) = False Then LoadFile = Replace(strFileLoadFail,"@path",strFilePath) : Exit Function End If
  Dim oStream : Set oStream = Server.CreateObject("ADODB.Stream")
  With oStream
  .Type = 2
  .Mode = 3
  .Open()
  .Charset = strCharset
  .Position = .Size
  
  .LoadFromFile strFilePath
  LoadFile = .ReadText
  
  .Close()
  End With
  Set oStream=Nothing
End Function

'//----保存文件
Private Function SaveToFile(ByVal strContent,ByVal strFilePath,ByVal strCharset)
  Dim oStream : Set oStream = Server.CreateObject("ADODB.Stream")
  With oStream
  .Type = 2'以本模式读取
  .mode = 3
  .Open()
  .Charset = strCharset
  .Position = .Size
  
  .WriteText(strContent)
  .SaveToFile strFilePath,2
  
  .Flush
  .Close
  End With
  Set oStream=Nothing
  
  SaveToFile = iif((Err.Number = 0),True,False)
End Function

'////////////////////////////////////////////////数据应用部分'///////////////////////////////////////////////
'//标签属性的支持
'//如果需要做自己的属性支持，在这里扩展
Private Function TagProperty(ByVal strTag,ByVal tagVal,ByVal strVal)
Dim i,return : return = strVal
	tagVal = Trim(tagVal)
  Select Case (lcase(Trim(strTag)))
	 Case "len","length":'截取长度的支持
	 	   If Len(tagVal) Then
		   return = Left(return,Int(tagVal))
		   End If		   
	 Case "return":'返回值{@var return="len"}
	 		tagVal = Split(lcase(trim(tagVal)),",")
			For i = 0 To Ubound(tagVal)
				Select Case (trim(tagVal(i)))
				Case "len","length":'返回变量的字符串长度
					return = Len(return)
				Case "trim":'去掉前后空格
					return = Trim(return)
				Case "urlencode":'返回URLEncode
					return = Server.URLEncode(return)
				Case "jsoncode":'把json字符转义
					return = jsonCode(return)
				Case "clearhtml","removehtml":'清除html格式
					return = removeHTML(return)
				Case "clearspace":
					return = removeSpace(return)
				Case "clearformat":'清除所有格式
					return = removeSpace(removeHTML(return))
				End Select
			Next
	 Case "dateformat":'日期格式化
		   return = DateFormat(return,tagVal)
	 
   End Select
  TagProperty = return
End Function
'//日期格式化
Private Function DateFormat(ByVal strDate,ByVal strFormat)
  Dim return : return = strFormat
  Dim ccDate
    If IsDate(strDate)=False Then DateFormat = strDate : Exit Function End If
	
	'下面开始进行日期的转换
   ccDate = FormatDateTime(strDate, vbGeneralDate )
   '显示方式
   Select Case(strFormat)
   Case "0" : 'vbGeneralDate 0 显示日期和/或时间。如果有日期部分，则将该部分显示为短日期格式。如果有时间部分，则将该部分显示为长时间格式。如果都存在，则显示所有部分。
     return = FormatDateTime(strDate, 0 )
   Case "1" : 'vbLongDate 1 使用计算机区域设置中指定的长日期格式显示日期
     return = FormatDateTime(strDate, 1 )
   Case "2" : 'vbShortDate 2 使用计算机区域设置中指定的短日期格式显示日期 
     return = FormatDateTime(strDate, 2 )
   Case "3" : 'vbLongTime 3 使用计算机区域设置中指定的时间格式显示时间
     return = FormatDateTime(strDate, 3 )
   Case "4" : 'vbShortTime 4 使用 24 小时格式 (hh:mm) 显示时间
     return = FormatDateTime(strDate, 4 )
   Case Else
	   With regEx
	   '年月日是小写，时分秒是大写
	   .IgnoreCase = False
	   .Global = True
	   .Pattern = "yyyy" : return = .Replace(return, Year(ccDate))
	   .Pattern = "yy"   : return = .Replace(return, Right(Year(ccDate),2))
	   .Pattern = "mm"   : return = .Replace(return, Right("0" & Month(ccDate),2))
	   .Pattern = "m"    : return = .Replace(return, Month(ccDate))
	   .Pattern = "dd"   : return = .Replace(return, Right("0" & Day(ccDate),2))
	   .Pattern = "d"    : return = .Replace(return, Day(ccDate))
	   .Pattern = "HH"   : return = .Replace(return, Right("0" & Hour(ccDate),2))
	   .Pattern = "H"    : return = .Replace(return, Hour(ccDate))
	   .Pattern = "MM"   : return = .Replace(return, Right("0" & Minute(ccDate),2))
	   .Pattern = "M"    : return = .Replace(return, Minute(ccDate))
	   .Pattern = "SS"   : return = .Replace(return, Right("0" & Second(ccDate),2))
	   .Pattern = "S"    : return = .Replace(return, Second(ccDate))
	   .Pattern = "w|W"  : return = .Replace(return, Right(weekdayname(weekday(ccDate)),1))
	   .IgnoreCase = True
	   End With
   End Select

  DateFormat = return
End Function
'转义JSON字符串
Private Function jsonCode(ByVal strHtml)
Dim str
  str = strHtml
  str = Replace(str,"\","\\")
  str = Replace(str,"/","\/")
  'str = Replace(str,",","\,")
  str = Replace(str,"'","\'")
  str = Replace(str,"""","\""")
  str = Replace(str,"{","\{")
  str = Replace(str,"}","\}")
  str = Replace(str,"[","\[")
  str = Replace(str,"]","\]")
  str = Replace(str,Chr(9),"\t")'//制表符
  str = Replace(str,Chr(10),"\n")'//换行
  str = Replace(str,Chr(13),"\r")'//回车
  
  jsonCode = str
End Function  

'清除HTML格式
Private Function removeHTML(ByVal strHtml)
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "<[^>]*>"
  removeHTML = regEx.Replace(strHtml, "")
End Function    

'清除所有的空格，空行等格式，只留文本
Private Function removeSpace(ByVal strHtml)
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "[\n\s*\r|]"
  removeSpace = regEx.Replace(strHtml, "")
End Function    
'////////////////////////////////////////////////数据应用部分'///////////////////////////////////////////////

'////////////////////////////////////////////////模板输出部分'////////////////////////////////////////////////
'判断输出，返回真或者假
Private Function ifOperator(ByVal strOpera,ByVal strVar,ByVal strValue)
on error resume next
  Dim return : return = False
  
  strVar = Trim(strVar)
  strValue = Trim(strValue)
  
  '运算符支持
  Select Case(lcase(strOpera))
	 Case "==":			return = (cstr(strVar) =  cstr(strValue))
	 Case "<=","&lt;=":	return = (cdbl(strVar) <= cdbl(strValue))
	 Case ">=","&gt;=":	return = (cdbl(strVar) >= cdbl(strValue))
	 Case ">","&gt;": 	return = (cdbl(strVar) >  cdbl(strValue))
	 Case "<","&lt;": 	return = (cdbl(strVar) <  cdbl(strValue))
	 Case "!=","<>","&lt;&gt;":return = (cstr(strVar) <> cstr(strValue))
  End Select
  
ifOperator = iif((Err.Number = 0),return,False)
End Function
'//----单值替换,替换Assign_Tag 标签 block_attr_list
Private Function Assign_tag(ByVal strCode,ByVal Pattern)
  Dim html : html = strCode
  Dim Match,Matches

  '单标签处理
      regEx.Pattern = Pattern
  Set Matches = regEx.Execute(html) '执行搜索
  
  '单标签支持
  '0=标签名,1=标签属性
  For Each Match in Matches
	  html = Replace(html,Match.value,Return_Tag_Val(var_list(lcase(Match.SubMatches(0))),Match.SubMatches(1)))
  Next
  Set Matches = Nothing
  Assign_tag = html
End Function

'//----逻辑判断块的输出
Private Function Assign_if(ByVal strCode)
  Dim html : html = strCode
  Dim strVar,strOperator,strValue
  Dim return : return = false
  Dim OutputTag
  Dim arrBlock,block_index
  Dim Match,Matches
      regEx.Pattern = "{if name=""(.*?)""}"
  Set Matches = regEx.Execute(html) '执行搜索。
  
  For Each Match in Matches
      block_index = Trim(Match.SubMatches(0))'if块的索引
	  '获取到索引后,读取字典数据
	  '0索引,1=条件(),2分支
	  arrBlock = block_if(block_index)

	  'if的条件
	  strVar = Assign_tag(arrBlock(1)(0),"(@\w+)(.*)?")'外部输入的值
	  strOperator = Trim(arrBlock(1)(1))'运算符
	  strValue = Assign_tag(arrBlock(1)(2),"(@\w+)(.*)?")'支持表达式两边是变量
	  
	  '表达式运算
	  return = ifOperator(strOperator,strVar,strValue)
	  
	  '分支的选择
	  If Ubound(arrBlock(2))>0 Then'如果有多个分支
	    OutputTag = iif(return,arrBlock(2)(0),arrBlock(2)(1))
	  Else
	    OutputTag = iif(return,arrBlock(2)(0),"")
	  End If
	  
	  '输出标签
	  html=Replace(html,Match.value,OutputTag)
	  
  Next
  Set Matches = Nothing
  Assign_if = html
End Function

'//----提取出loop里面的empty标签，并且解析出loop标签
'//返回数组0=loop主体,1=empty
Private Function Assign_loop_bodytag(ByVal strCode)
  Dim aryBody(1)
  Dim Match,Matches
      regEx.Pattern = "<empty>([\s\S]*?)</empty>"
  Set Matches = regEx.Execute(strCode) '执行搜索
  If Matches.Count>0 Then'如果有<empty>标签
    For Each Match In Matches
      aryBody(0) = regEx.Replace(strCode, "")'提取主体
	  aryBody(1) = Match.SubMatches(0)
	Next
  Else
      aryBody(0) = strCode
	  aryBody(1) = ""
  End If
  Set Matches = Nothing
  Assign_loop_bodytag = aryBody
End Function

'//----循环块的输出
Private Function Assign_loop(ByVal strCode)
  Dim html : html = strCode
  Dim BlockValue,OutputTag
  Dim i , j , max
  Dim block_index,arrBlock,strBlock
  Dim Match,Matches

  '循环体输出
  '//-----------------------loop
      regEx.Pattern = "{loop name=""(.*?)""}"
  Set Matches = regEx.Execute(html) '执行搜索。  
  For Each Match in Matches
      block_index = Trim(Match.SubMatches(0))'loop块的索引
	  '获取到索引后,读取字典数据
	  '0索引,1='数组对象(0=名,1=值),2循环体
	  arrBlock = block_loop(block_index)
      
	  '块的值
	  BlockValue = var_loopblocklist(block_index)
	  
	  '块的循环体'检测循环体中的<empty>标签,并且提取出来
	  strBlock = Assign_loop_bodytag(arrBlock(2))
	  
	  OutputTag = ""
	  If IsArray(BlockValue) Then'如果输入的是数组
	    Dim rs : rs = BlockValue
		'循环输出记录集'由于是二维数组，没有记录到字段名，所以数据输出只能用下标
	    max = Ubound(rs,2)
		For i = 0 To max'循环输出记录
		  OutputTag = OutputTag & Assign_loop_Tag(block_index ,strBlock(0) ,rs , i)'标签输出
		  OutputTag = Replace(OutputTag,"(i)",i + 1)'序号输出
		  OutputTag = Replace(OutputTag,"(max)",max + 1)'序号输出
		  OutputTag = Return_If_Tag_Val(OutputTag)'支持loop里面的if
		Next
	  Else
	     OutputTag = strBlock(1)'支持自定义记录为空的模板
		 OutputTag = Return_If_Tag_Val(OutputTag)'支持loop里面的if
	  End If
	  
	  html = Replace(html,Match.value,OutputTag)
	  
  Next
  Set Matches = Nothing
  Assign_loop = html
End Function

'//循环块内部的处理,替换循环体的标签：块名,循环体,记录集,行号
Private Function Assign_loop_Tag(ByVal strTag ,ByVal strBody ,ByVal arrRs ,ByVal intRowsNum)
  Dim OutputTag,html : html = strBody
  Dim rs : rs = arrRs
  Dim id
  Dim Match,Matches
	  regEx.Pattern = "\(@([\d|\w]+)(.*?)\)"
      regEx.Global = True
      regEx.IgnoreCase = True
  Set Matches = regEx.Execute(strBody) '执行搜索
  For Each Match in Matches
  	  OutputTag = ""
      '0=字段名或者下标,1=输出属性
	  'Ubound(rs,1)字段大小
	  id = Match.SubMatches(0)'索引出列名或者列id
	  '循环体的标签名是字段名还是下标，最终是以下标为准，如果传递的是字段名，也要把索引ID返回
	  id = iif(IsNumeric(id), id, rsField(lcase(strTag&"."&id)))
	  
	  '单标签的值
	  '如果下标超过字段宽度，那么这个值为空
	  If Len(id)>0 Then
	     id = Int(id)
	     OutputTag = iif( (id>Ubound(rs,1)),"",Return_Tag_Val(rs(id , intRowsNum),Match.SubMatches(1)))
	  End If
	  
	  html = Replace(html,Match.value,OutputTag)
  Next
  Set Matches = Nothing
Assign_loop_Tag = html
End Function

'//支持loop里的if
Private Function Return_If_Tag_Val(ByVal strBody)
  Dim OutputTag,tmpStr,tmpArr,html : html = strBody
  Dim return,strVar,strOperator,strValue
  Dim Match,Matches

      regEx.Pattern = "{if\s*(.+?)\s*("&ops&")\s*['""|]*(.+?)['""|]*\s*}([\s\S.]*?){\/if}"
  Set Matches = regEx.Execute(strBody) '执行搜索
  '0=条件,1=表达式,2值,3=分支
  For Each Match in Matches
      strVar = Assign_tag(Trim(Match.SubMatches(0)),"(@\w+)(.*)?")
      strOperator = Match.SubMatches(1)
	  strValue = Assign_tag(Trim(Match.SubMatches(2)),"(@\w+)(.*)?")
	  tmpArr = Split(Match.SubMatches(3), "{else}")'分支的选择
      
	  If Ubound(tmpArr) Then tmpStr = tmpArr(1)
	  '如果表达式成立,返回分支1，否则返回分支2
	  OutputTag = iif(ifOperator(strOperator,strVar,strValue),tmpArr(0),tmpStr)

	  html = Replace( html , Match.value , OutputTag )
  Next
  Set Matches = Nothing
Return_If_Tag_Val = html
End Function

'//----单标签替换输出,支持带属性输出
Private Function Return_Tag_Val(ByVal strVal,ByVal strAttr)
'传递值和属性参数过来，根据属性 返回不同的值回去
  If IsNull(strVal) Then Return_Tag_Val="" : Exit Function
  Dim arrAttr,tagVal
  Dim i
  Dim return : return = strVal
	  arrAttr = Analysis_block_loop_attr(Trim(strAttr))'获取属性列表
	  '如果有参数
      IF IsArray(arrAttr) Then
	    For i = 0 To Ubound(arrAttr)'逐个检查属性
		  'arrAttr(i,0)'标签
		  'arrAttr(i,1)'输入的值
		  return = TagProperty(Trim(arrAttr(i,0)),arrAttr(i,1),return)'标签属性的支持
		Next
	  End If
  Return_Tag_Val = return
End Function

'//变量替换
Private Function Assign()
  Dim html : html = strTemplate
      '先逻辑
      html = Assign_if(html)
	  
	  '循环块
	  html = Assign_loop(html)

      '单标签
	  html = Assign_tag(html,"{(@\w+)(.*?)}")

strTemplate = html
End Function

'////////////////////////////////////////////////模板输出部分'////////////////////////////////////////////////

'////////////////////////////////////////////////模板解析部分'////////////////////////////////////////////////
'//----解析loop 块的属性,返回属性的数组
Private Function Analysis_block_loop_attr(ByVal strCode)
  Dim arr : arr = False
  Dim Match,Matches
  Dim Pattern : Pattern = "\s?(\w.+?)\s*=\s*['""|]([\s\S.]*?)['""|]\s+"
  Dim i : i = 0
   
      regEx.Pattern = Pattern
  Set Matches = regEx.Execute(" " & strCode & " ") '执行搜索。

  If Matches.count Then
    ReDim arr(Matches.count - 1 , 1)
    '0=属性,1=属性值
    For Each Match in Matches
	  arr(i,0) = Match.SubMatches(0)
	  arr(i,1) = Match.SubMatches(1)
	  i = i + 1
    Next

  End If
  Set Matches = Nothing
  Analysis_block_loop_attr = arr
End Function

'//----解析 if 块
Private Function Analysis_block_if(ByVal strCode)
  Dim html : html = strCode
  Dim Match,Matches
  Dim Pattern : Pattern = "{if\s*(.+?)\s*("&ops&")\s*['""|]*(.+?)['""|]*\s*}([\s\S.]*?){\/if}"
  Dim block_id,block_name
  Dim arrAttr(2),arrBranch '分支结构
  Dim i , j : j = 0
  Dim arrBlock_if(2)

      regEx.Pattern = Pattern
  Set Matches = regEx.Execute(html) '执行搜索。
 '0=条件,1=表达式,2值,3=分支
  For Each Match in Matches
    j = j + 1 '序号作为块的标识
	'0=条件,1=表达式,2值,3=分支
	 arrAttr(0) = Match.SubMatches(0)
	 arrAttr(1) = Match.SubMatches(1)
	 arrAttr(2) = Match.SubMatches(2)
	 arrBranch  = Match.SubMatches(3)
	
     block_id = Lcase("block_" & j)
	 block_name = "{if name=""@name""}" '块的名字
	 block_name = Replace(block_name , "@name" , block_id)
	  
	 '缓存块id
	 arrBlock_if(0) = block_id'索引
	 arrBlock_if(1) = arrAttr'条件
	 arrBlock_if(2) = Split( arrBranch , "{else}" )'分支结构

	 '把块变量保存到块的数据字典
	 block_if(block_id) = arrBlock_if
	

	 '把if块替换成单标签,并且有特定的标记
     html = Replace( html , Match.value , block_name )

  Next
  Set Matches = Nothing
  Analysis_block_if = html
End Function

'//----解析循环模块
Private Function Analysis_block_loop(ByVal strCode)
  Dim html : html = strCode
  Dim Match,Matches
  Dim Pattern : Pattern = "(<loop(\s*?(.+?)(name\s*?=\s*?['""](.+?)['""])?([\s\S.]*?))>)([\s\S.]*?)<\/loop>"
  Dim block_id,block_name
  Dim arrAttr,arrBranch '分支结构
  Dim i , j : j = 0
  Dim k : k = 0
  Dim arrBlock_loop(2)

      regEx.Pattern = Pattern
  Set Matches = regEx.Execute(html) '执行搜索。
  '0=标签头,1=参数部分,4=name的名称,如果没有就为空,6=循环模板
  For Each Match in Matches
    j = j + 1 '序号作为块的标识
	block_name = Trim(Match.SubMatches(4))
	arrAttr = Analysis_block_loop_attr(Match.SubMatches(1))
	If IsArray(arrAttr) Then
      block_id = Lcase(iif(Len(block_name),block_name,"block_" & j))
	  block_name = "{loop name=""@name""}" '块的名字
	  block_name = Replace(block_name , "@name" , block_id)

	  '缓存块id
	  arrBlock_loop(0) = block_id
	  arrBlock_loop(1) = arrAttr'数组对象，0=名,1=值
	  arrBlock_loop(2) = Match.SubMatches(6)'循环体

	  '把块变量保存到块的数据字典
	  block_loop(block_id) = arrBlock_loop
	  block_loop_list(block_id) = arrAttr'输出块内容，输出值是:块名，属性对象（数组结构）
	  
	  '设置输出属性
	  For k = 0 To Ubound(arrAttr)
	     block_attr_list(block_id & "." & arrAttr(k,0)) = arrAttr(k,1)
	  Next
	  
	Else
	  block_name = Match.value
	End If
	
	'把if块替换成单标签,并且有特定的标记
    html = Replace( html , Match.value , block_name )
	
  Next
  Set Matches = Nothing
  Analysis_block_loop = html
End Function

'输出结果输出模板的绝对路径
Private Function AbsPath(ByVal strCode)
  Dim html : html = strCode
  Dim Matches,Match
  Dim spath
      regEx.Pattern = "(href|src)=(['""|])(?!(\/|\{@|\(@|\.\/|http:\/\/|https:\/\/|javascript:|#))(.+?)(['""|])"
	  Set Matches = regEx.Execute(html) '执行搜索。
	  For Each Match in Matches
		html = Replace( html , Match.value , Replace(Match.value,Match.SubMatches(3),RelPath(Match.SubMatches(3))) )
	  Next
  
  '如果指定安装目录,在绝对路径前面加上安装目录
  IF Len(strVirPath) Then
      regEx.Pattern = "(href|src)=(['""|])(?!(\{@|\(@|\.\/|http:\/\/|https:\/\/|javascript:|#))(.+?)(['""|])"
	  Set Matches = regEx.Execute(html) '执行搜索。
	  For Each Match in Matches
		html = Replace( html , Match.value , Replace(Match.value,Match.SubMatches(3),strVirPath & Match.SubMatches(3)) )
	  Next
  End IF
  
  AbsPath = html
End Function

'替换相对路径
'根据模板路径把../逐层替换到对应的目录
Private Function RelPath(ByVal strPath)
  Dim src,spath,i
  Dim Matches
      regEx.Pattern = "^(\.\.\/)+"
  Set Matches = regEx.Execute(strPath)
  
  '模板的全路径
  spath = Split(Replace(strTemplate_dir & strTemplate_path,"\","/"),"/")
  If Matches.count=0 Then
		For i=0 To Ubound(spath) - 1
		  src = src & spath(i) & "/"
		Next
		RelPath = src & strPath
		Exit Function
  ELSE
		regEx.Pattern = "(\.\.\/)"'看有多少个../
		For i=0 To Ubound(spath) - 1 - regEx.Execute(Matches(0).value).count
		  src = src & spath(i) & "/"
		Next
		'把../替换成正确的目录
		RelPath = Replace(strPath,Matches(0).value,src)
  End If
End Function

'//'//解析模板 
Private Sub Analysis()
  Dim html : html = strTemplate
  
  '先解析loop块
  html = Analysis_block_loop(html)
    
  '解析if块
  html = Analysis_block_if(html)
  
  strTemplate = html '解析后的html 放回临时变量中
End Sub

'//获得本页地址
Public Property Get thispageurl()
	'当前页面的连接
	thispageurl = Request.ServerVariables("URL")+iif(Len(Request.QueryString()),"?" & Request.QueryString(),"")
End Property

Private Property Get cachedir
  cachedir = strSITEROOT & strCache_dir & strTemplate_dir & Replace(Replace(strTemplate_path,"/","-"),"\","-")
End Property
'//---------------------------定义类的输入属性-------------------------------//
Public Property Let setCharset(ByVal strVar)
  strCharset = strVar
End Property

Public Property Let SITE_ROOT(ByVal strVar)
  strSITEROOT = strVar
End Property

Public Property Let setTemplatedir(ByVal strVar)
  strTemplate_dir = strVar
End Property

Public Property Let setCachedir(ByVal strVar)
  strCache_dir = strVar
End Property

Public Property Let path(ByVal strVar)
  strTemplate_path = strVar
End Property

Public Property Let setCache(ByVal intVar)
  intCacheflag = intVar
End Property

Public Property Let setCachePageName(ByVal strVar)
	strCachePageName = strVar & ".html"
End Property

Public Property Let setAbsPath(ByVal intVar)
  intAbsPath = intVar
End Property

'--//安装路径
'--//tpl.setVirPath = "" '不能以/结尾
Public Property Let setVirPath(ByVal strVar)
  strVirPath = Trim(strVar)
End Property

Public Property Let add(ByVal strTag,ByVal strVal)
  Dim rs,i
  '单标签赋值
  strTag = Trim(Lcase(strTag))
  
  If Left(strTag,1)="@" Then
	 '如果是记录集赋值
	 If TypeName(strVal) = "Recordset" Then
		 Set rs = strVal
		 '字段设置
		 If rs.State And Not rs.Eof Then
			 '将字段值自动赋值到标签中
			 For i=0 to rs.Fields.count-1
				strTag = "@"&lcase(rs.Fields(i).name)
				If var_list.Exists(strTag) Then var_list.Remove(strTag)
				   var_list(strTag) = iif(IsNull(rs(i)),"",rs(i))
			 Next
			'rs.Close()'程序后面还可以引用rs记录集，所以这里不用关闭，不过在外面的时候记得要关闭
		 End If
		 Set rs = Nothing
	 	 Exit Property
	 Else If var_list.Exists(strTag) Then var_list.Remove(strTag) '单标签赋值
		 	 var_list(strTag) = iif(IsNull(strVal),"",strVal)
		 Exit Property
	 End If
  End If
  
  '循环体赋值,传递的是Rs
  If TypeName(strVal) = "Recordset" Then
     Set rs = strVal
	 '字段设置
	 If rs.State And Not rs.Eof Then
		 For i=0 to rs.Fields.count-1 
			rsField(lcase(strTag&"."&rs.Fields(i).name)) = i
		 Next
		 
		 '赋值到循环块列表中
		If var_loopblocklist.Exists(strTag) Then var_loopblocklist.Remove(strTag)
		   var_loopblocklist(strTag) = rs.GetRows'赋值到循环块列表中
		 'rs.Close()'程序后面还可以引用rs记录集，所以这里不用关闭，不过在外面的时候记得要关闭
	 End If
	 Set rs = Nothing
	 Exit Property
  End If
  
  '如果传递的是getrows
  If TypeName(strVal) = "Variant()" Then
	 If var_loopblocklist.Exists(strTag) Then var_loopblocklist.Remove(strTag)
	 	var_loopblocklist(strTag) = strVal
  End If
  
End Property

Public Property Let bindfield(ByVal strTag,ByVal strVal)
  '绑定字段
  If TypeName(strVal) = "Fields" Then
     Dim rs,i
     Set rs = strVal
	 '字段设置
     For i=0 to rs.count-1 
        rsField(lcase(strTag&"."&rs(i).name)) = i
     Next
	 Set rs = Nothing
	 Exit Property
  End If
End Property

Public Property Let CachePageTimeout(ByVal strVal)
  intCachePageTimeout = Int(strVal)
  If cbool(intCachePageTimeout) Then
  	'检查缓存页面名称 strCachePageName
	IF Len(strCachePageName)=0 THEN
		strCachePageName = Replace(thispageurl(),"/","_")
		strCachePageName = Server.URLEncode(strCachePageName) & ".html"
	END IF
	
	Dim CachePagePath : CachePagePath = "pagecache/"
	
	 call AutoCreateFolder(strSITEROOT & strCache_dir & CachePagePath)'自动生成存放目录

	 strCachePage = strSITEROOT & strCache_dir & CachePagePath & strCachePageName
	 If objFSO.FileExists(strCachePage) Then'如果没有缓存
	 	Dim Files
	 	Set Files = objFSO.GetFile(strCachePage)
		'如果超时了
	 	If DateDiff("n", FormatDateTime(Files.DateLastModified,0),Now())<intCachePageTimeout Then
			'如果没有超时,读取缓存,至于缓存是用server.transfer还是fso,区别在于是否需要执行页面中的程序
			Server.Transfer(strCache_dir & CachePagePath & strCachePageName)
			'Response.Write(LoadFile(strCachePage,strCharset))
			Response.End()
		Else
		intCreateCachePage = True'缓存的内容超时
		End If
	 Else
	 	intCreateCachePage = True'没有缓存
	 End If
  End If
End Property

'////////////////////////////////////////////////公有方法部分'///////////////////////////////////////////////
'//----该方法用来加载模板
Public Property Get Load()
  '加载模板
  If Len(strTemplate_path)=0 Then  Exit Property
  
  Dim strPath : strPath = strSITEROOT & strTemplate_dir 
  Dim html
  Dim Match,Matches
	  
      '直接加载模板
      html = LoadFile(strPath & strTemplate_path,strCharset)''读取模板数据
  
      'include优先
          regEx.Pattern = "{include\(['""]*(.+?)['""]*\)}"
      Set Matches = regEx.Execute(html) '执行搜索。
      For Each Match in Matches
	      html=Replace(html,Match.value,LoadFile(strPath & Match.SubMatches(0),strCharset))
      Next
      Set Matches = Nothing
	  
      strTemplate = iif(cbool(intAbsPath),AbsPath(html),html)'输出的模板是否带绝对路径
      
	  call Analysis()'解析模板
	  
End Property

'//----该方法用来输出模板
Public Property Get Display
  call Assign()'解析数据 替换输出
  Response.Write( strTemplate )
  
  If cbool(intCreateCachePage) Then'如果设置了整页面缓存,就缓存这个页面
  call SaveToFile(strTemplate, strCachePage, strCharset)
  End If
End Property


Public Property Get CreatePage(ByVal strPath,ByVal strVar)
  Dim strOutputPath
  strOutputPath = strPath & "/" & strVar
  If AutoCreateFolder(strPath) Then
     call Assign()'数据替换输出
     call SaveToFile(strTemplate, strOutputPath, strCharset)
  End If
End Property

Public Property Get gethtml
  call Assign()'数据替换输出
  gethtml = strTemplate
End Property

Public Property Get getblock
  Set getblock = block_loop_list
End Property

Public Property Get blockattr(ByVal strPath)
  blockattr = block_attr_list(Lcase(strPath))
End Property

Public Property Get getattr
  Set getattr = block_attr_list
End Property

Public Property Get RunTimer
 RunTimer = FormatNumber(Timer() - intStartTime,4,True,False,True)
End Property

'//结束
End Class
%>